DEV ROC betaseries
Dani Cosme
2023-02-02
prep
load packages
library(tidyverse)
library(lme4)
library(lmerTest)
library(knitr)
library(cowplot)
library(caret)
library(ROCR)define aesthetics
algorithm = c("#006989", "#FEC601", "#F43C13", "#00A5CF", "#00A878")
instruction = wesanderson::wes_palette("Darjeeling1", 2, "continuous")
craving = wesanderson::wes_palette("Darjeeling1", 3, "continuous")
rating = c("#00A08A", "#F2AD00", "#F98400", "#FF0000")
dc_bw = plot_aes = theme_minimal() +
theme(legend.position = "top",
legend.text = element_text(size = 12),
text = element_text(size = 16, family = "Futura Medium"),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.text = element_text(color = "black"),
axis.line = element_line(colour = "black"),
axis.ticks.y = element_blank())define functions
table_model = function(model_data) {
model_data %>%
broom.mixed::tidy(., conf.int = TRUE) %>%
rename("SE" = std.error,
"t" = statistic,
"p" = p.value) %>%
filter(effect == "fixed") %>%
select(-group, -effect) %>%
mutate_at(vars(-contains("term"), -contains("value")), round, 2) %>%
mutate(term = gsub(":", " x ", term),
term = gsub("dot_", "", term),
term = gsub("wave2", " wave (post)", term),
term = gsub("instructionregulate", "instruction (regulate)", term),
p = ifelse(p < .001, "< .001",
ifelse(p == 1, "1.000", gsub("0.(.*)", ".\\1", sprintf("%.3f", p)))),
`b [95% CI]` = sprintf("%.2f [%0.2f, %.2f]", estimate, conf.low, conf.high)) %>%
select(term, `b [95% CI]`, df, t, p) %>%
kable()
}load tidied data
source("load_data.R")check ratings
Check if wrong buttons were used (i.e., not 5-8)
- DEV001 = code normally
- DEV011 = code normally
- DEV016 = code normally
- DEV017 = exclude; can’t tell if they’re missed ratings or incorrect placement of fingers
- DEV019 = exclude; can’t tell if they’re missed ratings or incorrect placement of fingers
- DEV020 = code normally
- DEV022 = code normally
- DEV028 = code normally
- DEV032 = incorrect placement of fingers; recode runs 1-2 (LOOK INTO WTP)
- DEV037 = exclude; technical error?
- DEV054 = exclude; technical error?
- DEV060 = code normally; task ended early
- DEV061 = code normally; task ended early
- DEV063 = code normally; task ended early
- DEV069 = incorrect placement of fingers in run1
- DEV075 = code normally
- DEV082 = code normally
- DEV083 = code normally
NB! NEED TO GO THROUGH NEW PARTICPANTS/WAVES
subs = data.all %>%
group_by(subjectID, wave, run, rating) %>%
summarize(n = n()) %>%
spread(rating, n) %>%
mutate(messed = ifelse(is.na(`5`) & !is.na(`<NA>`), "yes", NA)) %>%
filter(messed == "yes") %>%
ungroup() %>%
select(subjectID, wave) %>%
unique()
data.all %>%
group_by(subjectID, run, rating) %>%
summarize(n = n()) %>%
spread(rating, n) %>%
mutate(messed = ifelse(is.na(`5`) & !is.na(`<NA>`), "yes", NA)) %>%
filter(subjectID %in% subs$subjectID)recode and exclude
Recoding
* DEV069: recode runs1
NB! NEED TO GO THROUGH NEW PARTICPANTS/WAVES
data.ex = data.all %>%
mutate(rating = ifelse(subjectID == "DEV069" & run == "run1", rating - 1, rating),
rating = ifelse(subjectID == "DEV069" & run == "run1" & is.na(rating), 8, rating),
rating = rating - 4) %>%
group_by(subjectID, wave) %>%
arrange(subjectID, run) %>%
mutate(trial = row_number())load mean intensity values
file_dir = "~/Documents/code/sanlab/DEV_scripts/fMRI/betaseries/ROC/dotProducts_ROC_wave1/"
file_pattern = "DEV[0-9]{3}_meanIntensity.txt"
file_list = list.files(file_dir, pattern = file_pattern)
intensities = data.frame()
for (file in file_list) {
temp = tryCatch(read.table(file.path(file_dir,file), fill = TRUE) %>%
rename("subjectID" = V1,
"meanIntensity" = V3) %>%
extract(V2, "beta", "beta_([0-9]{4}).nii") %>%
mutate(beta = as.integer(beta),
wave = 1), error = function(e) message(file))
intensities = rbind(intensities, temp)
rm(temp)
}
file_dir = "~/Documents/code/sanlab/DEV_scripts/fMRI/betaseries/ROC/dotProducts_ROC_wave2/"
file_list = list.files(file_dir, pattern = file_pattern)
for (file in file_list) {
temp = tryCatch(read.table(file.path(file_dir,file), fill = TRUE) %>%
rename("subjectID" = V1,
"meanIntensity" = V3) %>%
extract(V2, "beta", "beta_([0-9]{4}).nii") %>%
mutate(beta = as.integer(beta),
wave = 2), error = function(e) message(file))
intensities = rbind(intensities, temp)
rm(temp)
}load dot products
file_dir = "~/Documents/code/sanlab/DEV_scripts/fMRI/betaseries/ROC/dotProducts_ROC_wave1/"
file_pattern = "DEV[0-9]{3}_dotProducts.txt"
file_list = list.files(file_dir, pattern = file_pattern)
dots = data.frame()
for (file in file_list) {
temp = tryCatch(read.table(file.path(file_dir,file), fill = TRUE) %>%
rename("subjectID" = V1,
"map" = V3,
"dotProduct" = V4) %>%
extract(V2, "beta", "beta_([0-9]{4}).nii") %>%
extract(map, "algorithm", "(.*)_.*.nii") %>%
mutate(beta = as.integer(beta),
wave = 1), error = function(e) message(file))
dots = rbind(dots, temp)
rm(temp)
}
file_dir = "~/Documents/code/sanlab/DEV_scripts/fMRI/betaseries/ROC/dotProducts_ROC_wave2/"
file_list = list.files(file_dir, pattern = file_pattern)
for (file in file_list) {
temp = tryCatch(read.table(file.path(file_dir,file), fill = TRUE) %>%
rename("subjectID" = V1,
"map" = V3,
"dotProduct" = V4) %>%
extract(V2, "beta", "beta_([0-9]{4}).nii") %>%
extract(map, "algorithm", "(.*)_.*.nii") %>%
mutate(beta = as.integer(beta),
wave = 2), error = function(e) message(file))
dots = rbind(dots, temp)
rm(temp)
}join intensities and dots
- recode trials with extreme intensities as NA
dots.merged = dots %>%
left_join(., intensities, by = c("subjectID", "wave", "beta")) %>%
group_by(subjectID, wave, algorithm) %>%
mutate(rownum = row_number())
# plot original
dots.merged %>%
filter(algorithm == "craving_regulation") %>%
ggplot(aes(1, meanIntensity)) +
geom_boxplot()
# assess extreme values and exclude when calculating SDs
dots.merged %>%
filter(algorithm == "craving_regulation") %>%
arrange(meanIntensity)dots.merged %>%
filter(algorithm == "craving_regulation") %>%
arrange(-meanIntensity)# recode outliers as NA
dots.merged = dots.merged %>%
ungroup() %>%
mutate(meanIntensity = ifelse(meanIntensity > 1 | meanIntensity < -1, NA, meanIntensity),
median = median(meanIntensity, na.rm = TRUE),
sd3 = 3*sd(meanIntensity, na.rm = TRUE),
outlier = ifelse(meanIntensity > median + sd3 | meanIntensity < median - sd3, "yes", "no"),
dotProduct = ifelse(outlier == "yes", NA, dotProduct))
# plot after
dots.merged %>%
filter(algorithm == "craving_regulation") %>%
ggplot(aes(1, meanIntensity)) +
geom_boxplot()
recode subs
- DEV022 = run4 has 8 trials
- DEV037 = ???
- DEV048 = run4 missing
- DEV060 = run1 has 19 trials; couldn’t estimate run1 trial 19, run3 trial 20
- DEV061 = run3 has 19 trials; couldn’t estimate run3 trial 19
- DEV063 = run2 has 11 trials
- DEV081 = run2 missing (run1 was run twice)
- DEV082 = run2 has 15 trials; couldn’t estimate run1 trial 19, run1 trial 20
NB! NEED TO GO THROUGH NEW PARTICPANTS/WAVES
trial.numbers = data.frame(subjectID = c(rep("DEV060", 79), rep("DEV061", 79), rep("DEV063", 71), rep("DEV081", 80), rep("DEV082", 75)),
wave = 1,
rownum = c(1:79, 1:79, 1:71, 1:80, 1:75),
trial = c(1:19, 21:80, 1:59, 61:80, 1:31, 41:80, 1:20, 41:80, 21:40, 1:35, 41:80))
dots.check = dots.merged %>%
group_by(subjectID, wave, algorithm) %>%
mutate(rownum = row_number()) %>%
left_join(., trial.numbers, by = c("subjectID", "wave", "rownum")) %>%
mutate(trial = ifelse(is.na(trial), rownum, trial),
dotProduct = ifelse(subjectID == "DEV060" & wave == 1 & trial %in% 19:20, NA,
ifelse(subjectID == "DEV061" & wave == 1 & trial == 59, NA,
ifelse(subjectID == "DEV082" & wave == 1 & trial %in% 19:20, NA, dotProduct)))) %>%
select(-rownum) #%>%
#left_join(., striping, by = c("subjectID", "beta")) %>%
#mutate(dotProduct = ifelse(!is.na(striping), NA, dotProduct))merge data and exclude subs
Exclusions
- MRI motion and data quality exclusions: DEV001, DEV020, DEV032, DEV047, DEV055, DEV064, DEV066
- Button box exclusions: DEV017, DEV019, DEV037, DEV054
- Run exclusions: DEV029 (run3), DEV037 (run1), DEV042 (run4), DEV067 (run4)
Other
* select only craved trials
NB! NEED TO GO THROUGH NEW PARTICPANTS/WAVES
data_all = left_join(dots.check, data.ex, by = c("subjectID", "wave", "trial")) %>%
filter(!(subjectID %in% c("DEV001","DEV020","DEV032","DEV047","DEV055","DEV064","DEV066", "DEV017", "DEV019", "DEV037", "DEV054") & wave == 1)) %>%
filter(!(subjectID == "DEV029" & wave == 1 & run == "run3") & !(subjectID == "DEV037" & wave == 1 & run == "run1") & !(subjectID == "DEV042" & wave == 1 & run == "run4") & !(subjectID == "DEV067" & wave == 1 & run == "run4")) %>%
ungroup() %>%
mutate(algorithm = gsub("_signature", "", algorithm),
wave = as.character(wave))
data = data_all %>%
filter(craving == "craved")summarize
n participants by wave
data %>%
select(subjectID, wave) %>%
unique() %>%
group_by(wave) %>%
summarize(n = n())n trials
data %>%
filter(algorithm == "craving_regulation") %>%
group_by(subjectID) %>%
summarize(n = n()) %>%
arrange(n)roc
craving regulation signature
# roc curve
perf.df = data %>%
filter(algorithm == "craving_regulation") %>%
filter(!is.na(dotProduct) & !is.na(craving)) %>%
mutate(instruction = ifelse(instruction == "regulate", 1, 0)) %>%
group_by(wave) %>%
do({
wave = .$wave
pred = prediction(.$dotProduct, .$instruction, label.ordering = NULL)
perf = performance(pred, measure = "tpr", x.measure = "fpr")
data.frame(cut=perf@alpha.values[[1]],fpr=perf@x.values[[1]],tpr=perf@y.values[[1]])
})
ggplot(perf.df, aes(fpr, tpr, color = as.factor(wave))) +
geom_line() +
scale_color_manual(values = algorithm) +
xlab("false positive rate") +
ylab("true positive rate")
roc = data %>%
filter(algorithm == "craving_regulation") %>%
select(subjectID, trial, instruction, rating, dotProduct) %>%
mutate(guess.instruction = ifelse(dotProduct > 0, "regulate", "look"),
guess.rating = ifelse(dotProduct > 0, "low", "high"),
rating.bin = ifelse(rating >= 3, "high", "low"),
instruction = as.factor(instruction),
guess.instruction = as.factor(guess.instruction),
rating.bin = as.factor(rating.bin),
guess.rating = as.factor(guess.rating))
confusionMatrix(roc$guess.instruction, roc$instruction)## Confusion Matrix and Statistics
##
## Reference
## Prediction look regulate
## look 5536 2250
## regulate 3509 6784
##
## Accuracy : 0.6815
## 95% CI : (0.6746, 0.6882)
## No Information Rate : 0.5003
## P-Value [Acc > NIR] : < 0.00000000000000022
##
## Kappa : 0.363
##
## Mcnemar's Test P-Value : < 0.00000000000000022
##
## Sensitivity : 0.6121
## Specificity : 0.7509
## Pos Pred Value : 0.7110
## Neg Pred Value : 0.6591
## Prevalence : 0.5003
## Detection Rate : 0.3062
## Detection Prevalence : 0.4307
## Balanced Accuracy : 0.6815
##
## 'Positive' Class : look
## #confusionMatrix(roc$guess.rating, roc$rating.bin)craving signature
crave regulate v craved look
# roc curve
perf.df = data %>%
filter(algorithm == "craving") %>%
filter(!is.na(dotProduct) & !is.na(craving)) %>%
mutate(instruction = ifelse(instruction == "regulate", 1, 0)) %>%
group_by(wave) %>%
do({
wave = .$wave
pred = prediction(.$dotProduct, .$instruction, label.ordering = NULL)
perf = performance(pred, measure = "tpr", x.measure = "fpr")
data.frame(cut=perf@alpha.values[[1]],fpr=perf@x.values[[1]],tpr=perf@y.values[[1]])
})
ggplot(perf.df, aes(fpr, tpr, color = as.factor(wave))) +
geom_line() +
scale_color_manual(values = algorithm) +
xlab("false positive rate") +
ylab("true positive rate")
roc = data %>%
filter(algorithm == "craving") %>%
select(subjectID, trial, instruction, rating, dotProduct) %>%
mutate(guess.instruction = ifelse(dotProduct > 0, "regulate", "look"),
guess.rating = ifelse(dotProduct > 0, "low", "high"),
rating.bin = ifelse(rating >= 3, "high", "low"),
instruction = as.factor(instruction),
guess.instruction = as.factor(guess.instruction),
rating.bin = as.factor(rating.bin),
guess.rating = as.factor(guess.rating))
confusionMatrix(roc$guess.instruction, roc$instruction)## Confusion Matrix and Statistics
##
## Reference
## Prediction look regulate
## look 3625 4205
## regulate 5420 4829
##
## Accuracy : 0.4676
## 95% CI : (0.4603, 0.4749)
## No Information Rate : 0.5003
## P-Value [Acc > NIR] : 1
##
## Kappa : -0.0647
##
## Mcnemar's Test P-Value : <0.0000000000000002
##
## Sensitivity : 0.4008
## Specificity : 0.5345
## Pos Pred Value : 0.4630
## Neg Pred Value : 0.4712
## Prevalence : 0.5003
## Detection Rate : 0.2005
## Detection Prevalence : 0.4331
## Balanced Accuracy : 0.4677
##
## 'Positive' Class : look
## #confusionMatrix(roc$guess.rating, roc$rating.bin)craving v neutral
# roc curve
perf.df = data_all %>%
filter(algorithm == "craving") %>%
filter(!is.na(dotProduct)) %>%
filter(craving %in% c("neutral", "craved")) %>%
mutate(craving = ifelse(craving == "craved", 1, 0)) %>%
group_by(wave) %>%
do({
wave = .$wave
pred = prediction(.$dotProduct, .$craving, label.ordering = NULL)
perf = performance(pred, measure = "tpr", x.measure = "fpr")
data.frame(cut=perf@alpha.values[[1]],fpr=perf@x.values[[1]],tpr=perf@y.values[[1]])
})
ggplot(perf.df, aes(fpr, tpr, color = as.factor(wave))) +
geom_line() +
scale_color_manual(values = algorithm) +
xlab("false positive rate") +
ylab("true positive rate")
roc = data_all %>%
filter(algorithm == "craving") %>%
filter(craving %in% c("neutral", "craved")) %>%
select(subjectID, trial, craving, rating, dotProduct) %>%
mutate(guess.craving = ifelse(dotProduct > 0, "craved", "neutral"),
guess.rating = ifelse(dotProduct > 0, "low", "high"),
rating.bin = ifelse(rating >= 3, "high", "low"),
craving = as.factor(craving),
guess.craving = as.factor(guess.craving),
rating.bin = as.factor(rating.bin),
guess.rating = as.factor(guess.rating))
confusionMatrix(roc$guess.craving, roc$craving)## Confusion Matrix and Statistics
##
## Reference
## Prediction craved neutral
## craved 10249 3960
## neutral 7830 5095
##
## Accuracy : 0.5655
## 95% CI : (0.5596, 0.5714)
## No Information Rate : 0.6663
## P-Value [Acc > NIR] : 1
##
## Kappa : 0.1171
##
## Mcnemar's Test P-Value : <0.0000000000000002
##
## Sensitivity : 0.5669
## Specificity : 0.5627
## Pos Pred Value : 0.7213
## Neg Pred Value : 0.3942
## Prevalence : 0.6663
## Detection Rate : 0.3777
## Detection Prevalence : 0.5237
## Balanced Accuracy : 0.5648
##
## 'Positive' Class : craved
## #confusionMatrix(roc$guess.rating, roc$rating.bin)Koban craving signature
crave regulate v craved look
# roc curve
perf.df = data %>%
filter(algorithm == "nsc_koban") %>%
filter(!is.na(dotProduct) & !is.na(craving)) %>%
mutate(instruction = ifelse(instruction == "regulate", 1, 0)) %>%
group_by(wave) %>%
do({
wave = .$wave
pred = prediction(.$dotProduct, .$instruction, label.ordering = NULL)
perf = performance(pred, measure = "tpr", x.measure = "fpr")
data.frame(cut=perf@alpha.values[[1]],fpr=perf@x.values[[1]],tpr=perf@y.values[[1]])
})
ggplot(perf.df, aes(fpr, tpr, color = as.factor(wave))) +
geom_line() +
scale_color_manual(values = algorithm) +
xlab("false positive rate") +
ylab("true positive rate")
roc = data %>%
filter(algorithm == "nsc_koban") %>%
select(subjectID, trial, instruction, rating, dotProduct) %>%
mutate(guess.instruction = ifelse(dotProduct > 0, "regulate", "look"),
guess.rating = ifelse(dotProduct > 0, "low", "high"),
rating.bin = ifelse(rating >= 3, "high", "low"),
instruction = as.factor(instruction),
guess.instruction = as.factor(guess.instruction),
rating.bin = as.factor(rating.bin),
guess.rating = as.factor(guess.rating))
confusionMatrix(roc$guess.instruction, roc$instruction)## Confusion Matrix and Statistics
##
## Reference
## Prediction look regulate
## look 3714 4402
## regulate 5331 4632
##
## Accuracy : 0.4616
## 95% CI : (0.4544, 0.4689)
## No Information Rate : 0.5003
## P-Value [Acc > NIR] : 1
##
## Kappa : -0.0767
##
## Mcnemar's Test P-Value : <0.0000000000000002
##
## Sensitivity : 0.4106
## Specificity : 0.5127
## Pos Pred Value : 0.4576
## Neg Pred Value : 0.4649
## Prevalence : 0.5003
## Detection Rate : 0.2054
## Detection Prevalence : 0.4489
## Balanced Accuracy : 0.4617
##
## 'Positive' Class : look
## #confusionMatrix(roc$guess.rating, roc$rating.bin)craving v neutral
# roc curve
perf.df = data_all %>%
filter(algorithm == "nsc_koban") %>%
filter(!is.na(dotProduct)) %>%
filter(craving %in% c("neutral", "craved")) %>%
mutate(craving = ifelse(craving == "craved", 1, 0)) %>%
group_by(wave) %>%
do({
wave = .$wave
pred = prediction(.$dotProduct, .$craving, label.ordering = NULL)
perf = performance(pred, measure = "tpr", x.measure = "fpr")
data.frame(cut=perf@alpha.values[[1]],fpr=perf@x.values[[1]],tpr=perf@y.values[[1]])
})
ggplot(perf.df, aes(fpr, tpr, color = as.factor(wave))) +
geom_line() +
scale_color_manual(values = algorithm) +
xlab("false positive rate") +
ylab("true positive rate")
roc = data_all %>%
filter(algorithm == "nsc_koban") %>%
filter(craving %in% c("neutral", "craved")) %>%
select(subjectID, trial, craving, rating, dotProduct) %>%
mutate(guess.craving = ifelse(dotProduct > 0, "craved", "neutral"),
guess.rating = ifelse(dotProduct > 0, "low", "high"),
rating.bin = ifelse(rating >= 3, "high", "low"),
craving = as.factor(craving),
guess.craving = as.factor(guess.craving),
rating.bin = as.factor(rating.bin),
guess.rating = as.factor(guess.rating))
confusionMatrix(roc$guess.craving, roc$craving)## Confusion Matrix and Statistics
##
## Reference
## Prediction craved neutral
## craved 9963 5327
## neutral 8116 3728
##
## Accuracy : 0.5046
## 95% CI : (0.4986, 0.5105)
## No Information Rate : 0.6663
## P-Value [Acc > NIR] : 1
##
## Kappa : -0.0346
##
## Mcnemar's Test P-Value : <0.0000000000000002
##
## Sensitivity : 0.5511
## Specificity : 0.4117
## Pos Pred Value : 0.6516
## Neg Pred Value : 0.3148
## Prevalence : 0.6663
## Detection Rate : 0.3672
## Detection Prevalence : 0.5635
## Balanced Accuracy : 0.4814
##
## 'Positive' Class : craved
## #confusionMatrix(roc$guess.rating, roc$rating.bin)correlations among signatures
craving & Koban craving
data %>%
select(subjectID, wave, trial, algorithm, dotProduct) %>%
spread(algorithm, dotProduct) %>%
mutate(sub_wave = sprintf("%s_%s", subjectID, wave)) %>%
rmcorr::rmcorr(as.factor(sub_wave), craving, nsc_koban, data = .)##
## Repeated measures correlation
##
## r
## -0.06365789
##
## degrees of freedom
## 17616
##
## p-value
## 0.00000000000000002732407
##
## 95% confidence interval
## -0.0783515 -0.04893664craving & craving regulation
data %>%
select(subjectID, wave, trial, algorithm, dotProduct) %>%
spread(algorithm, dotProduct) %>%
mutate(sub_wave = sprintf("%s_%s", subjectID, wave)) %>%
rmcorr::rmcorr(as.factor(sub_wave), craving, craving_regulation, data = .)##
## Repeated measures correlation
##
## r
## 0.004821728
##
## degrees of freedom
## 17616
##
## p-value
## 0.5221987
##
## 95% confidence interval
## -0.009946238 0.01958759Koban craving & craving regulation
data %>%
select(subjectID, wave, trial, algorithm, dotProduct) %>%
spread(algorithm, dotProduct) %>%
mutate(sub_wave = sprintf("%s_%s", subjectID, wave)) %>%
rmcorr::rmcorr(as.factor(sub_wave), nsc_koban, craving_regulation, data = .)##
## Repeated measures correlation
##
## r
## -0.09404847
##
## degrees of freedom
## 17616
##
## p-value
## 0.000000000000000000000000000000000006568547
##
## 95% confidence interval
## -0.1086648 -0.07939147visualize raw data
instruction
across waves
data %>%
filter(!is.na(rating)) %>%
ggplot(aes(algorithm, dotProduct, fill = instruction)) +
stat_summary(fun.y = mean, geom = "bar", position = position_dodge(width = 0.95)) +
stat_summary(fun.data = mean_cl_boot, geom = "errorbar", position = position_dodge(width = 0.95), width = 0) +
scale_fill_manual(name = "", values = instruction) +
labs(y = "pattern expression value\n", x = "") +
dc_bw
data %>%
filter(!is.na(rating)) %>%
ggplot(aes(instruction, dotProduct)) +
stat_summary(aes(group = subjectID), fun.y = mean, geom = "line", alpha = .1, size = .5) +
stat_summary(aes(group = 1), fun.y = mean, geom = "line", size = .75) +
stat_summary(aes(color = instruction), fun.data = "mean_cl_boot", geom = "pointrange", width = 0, size = .75) +
facet_grid(~algorithm) +
scale_color_manual(name = "", values = instruction) +
labs(y = "pattern expression value\n", x = "") +
dc_bw
by waves
data %>%
filter(!is.na(rating)) %>%
ggplot(aes(instruction, dotProduct, fill = wave)) +
stat_summary(fun.y = mean, geom = "bar", position = position_dodge(width = 0.95)) +
stat_summary(fun.data = mean_cl_boot, geom = "errorbar", position = position_dodge(width = 0.95), width = 0) +
facet_grid(~algorithm) +
scale_fill_manual(name = "wave", values = algorithm) +
labs(y = "pattern expression value\n", x = "") +
dc_bw
data %>%
filter(!is.na(rating)) %>%
ggplot(aes(wave, dotProduct, color = instruction)) +
stat_summary(aes(group = interaction(subjectID, instruction)), fun.y = mean, geom = "line", alpha = .1, size = .5) +
stat_summary(aes(group = instruction), fun.y = mean, geom = "line", size = .75) +
stat_summary(fun.data = "mean_cl_boot", geom = "pointrange", width = 0, size = .75) +
facet_grid(~algorithm) +
scale_color_manual(name = "", values = instruction) +
labs(y = "pattern expression value\n", x = "") +
dc_bw
rating
across waves
data %>%
ggplot(aes(dotProduct, rating, color = algorithm, fill = algorithm)) +
geom_smooth(aes(group = interaction(subjectID, algorithm)), method = "lm", se = FALSE, size = .1) +
geom_smooth(method = "lm") +
scale_color_manual(name = "signature", values = algorithm) +
scale_fill_manual(name = "signature", values = algorithm) +
labs(y = "craving rating\n", x = "\npattern expression value") +
dc_bw
by wave
data %>%
ggplot(aes(dotProduct, rating, color = wave, fill = wave)) +
geom_smooth(aes(group = interaction(subjectID, wave)), method = "lm", se = FALSE, size = .1) +
geom_smooth(method = "lm") +
facet_grid(~algorithm) +
scale_color_manual(name = "wave", values = algorithm) +
scale_fill_manual(name = "wave", values = algorithm) +
labs(y = "craving rating\n", x = "\npattern expression value") +
dc_bw
rating and instruction
across waves
data %>%
ggplot(aes(dotProduct, rating, color = instruction, fill = instruction)) +
geom_smooth(aes(group = interaction(subjectID, instruction)), method = "lm", se = FALSE, size = .1) +
geom_smooth(method = "lm") +
facet_grid(~algorithm) +
scale_color_manual(name = "instruction", values = instruction) +
scale_fill_manual(name = "instruction", values = instruction) +
labs(y = "craving rating\n", x = "\npattern expression value") +
dc_bw
by wave
data %>%
ggplot(aes(dotProduct, rating, color = wave, fill = wave)) +
geom_smooth(aes(group = interaction(subjectID, instruction, wave)), method = "lm", se = FALSE, size = .1) +
geom_smooth(method = "lm") +
facet_grid(instruction~algorithm) +
scale_color_manual(name = "wave", values = algorithm) +
scale_fill_manual(name = "wave", values = algorithm) +
labs(y = "craving rating\n", x = "\npattern expression value") +
dc_bw
RT
craving
across waves
data %>%
filter(!is.na(rating)) %>%
filter(algorithm == "craving_regulation") %>%
ggplot(aes(rating, rt, color = instruction, fill = instruction)) +
geom_smooth(aes(group = interaction(subjectID, instruction)), method = "lm", se = FALSE, size = .1) +
geom_smooth(method = "lm", alpha = .2) +
facet_grid(~algorithm) +
scale_color_manual(name = "", values = instruction) +
scale_fill_manual(name = "", values = instruction) +
labs(x = "\ncraving rating", y = "reaction time (seconds)\n") +
dc_bw
by wave
data %>%
filter(!is.na(rating)) %>%
filter(algorithm == "craving_regulation") %>%
ggplot(aes(rating, rt, color = wave, fill = wave)) +
geom_smooth(aes(group = interaction(subjectID, wave, instruction)), method = "lm", se = FALSE, size = .1) +
geom_smooth(method = "lm", alpha = .2) +
facet_grid(~instruction) +
scale_color_manual(name = "", values = algorithm) +
scale_fill_manual(name = "", values = algorithm) +
labs(x = "\ncraving rating", y = "reaction time (seconds)\n") +
dc_bw
pattern expression
across waves
data %>%
filter(!is.na(rating)) %>%
ggplot(aes(dotProduct, rt, color = instruction, fill = instruction)) +
geom_smooth(aes(group = interaction(subjectID, instruction)), method = "lm", se = FALSE, size = .1) +
geom_smooth(method = "lm", alpha = .2) +
facet_grid(~algorithm) +
scale_color_manual(name = "", values = instruction) +
scale_fill_manual(name = "", values = instruction) +
labs(x = "\npattern expression value", y = "reaction time (seconds)\n") +
dc_bw
by wave
data %>%
filter(!is.na(rating)) %>%
ggplot(aes(dotProduct, rt, color = wave, fill = wave)) +
geom_smooth(aes(group = interaction(subjectID, instruction, wave)), method = "lm", se = FALSE, size = .1) +
geom_smooth(method = "lm", alpha = .2) +
facet_grid(instruction~algorithm) +
scale_color_manual(name = "", values = algorithm) +
scale_fill_manual(name = "", values = algorithm) +
labs(x = "\npattern expression value", y = "reaction time (seconds)\n") +
dc_bw
MLM
Disaggregate within and between person relationships
dot_between= grand mean centered person average signature expressiondot_within= person-centered signature expression
between = data %>%
group_by(wave, subjectID, algorithm) %>%
summarize(dot_between = mean(dotProduct, na.rm = TRUE)) %>%
ungroup() %>%
mutate(dot_between = scale(dot_between, center = TRUE, scale = TRUE))
data_diss = data %>%
group_by(wave, subjectID, algorithm) %>%
mutate(dot_within = scale(dotProduct, center = TRUE, scale = TRUE)) %>%
left_join(., between) %>%
select(subjectID, wave, trial, instruction, rating, algorithm, dotProduct, dot_within, dot_between)
data_diss_regulation = data_diss %>%
filter(algorithm == "craving_regulation")
data_diss_craving = data_diss %>%
filter(algorithm == "craving")
data_diss_craving_koban = data_diss %>%
filter(algorithm == "nsc_koban")no brain
craving ~ wave x instruction
the intervention decreased cravings; this effect is slightly weaker when regulating
tidytable
mod_insruction = lmer(rating ~ instruction * wave + (1 + instruction * wave | subjectID),
data = data_diss_craving,
control = lmerControl(optimizer = "bobyqa"))
table_model(mod_insruction)| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| (Intercept) | 3.27 [3.21, 3.33] | 252.93 | 105.68 | < .001 |
| instruction (regulate) | -0.94 [-1.01, -0.86] | 251.63 | -25.92 | < .001 |
| wave (post) | -0.59 [-0.68, -0.51] | 210.73 | -13.72 | < .001 |
| instruction (regulate) x wave (post) | 0.10 [0.03, 0.18] | 218.23 | 2.70 | .010 |
plot
ggeffects::ggpredict(mod_insruction, terms = c("wave", "instruction")) %>%
data.frame() %>%
ggplot(aes(x, predicted, color = group, fill = group)) +
geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
geom_line(aes(group = group)) +
scale_color_manual(name = "", values = instruction) +
scale_fill_manual(name = "", values = instruction) +
labs(x = "\nwave", y = "predicted bid value\n") +
dc_bw
model summary
summary(mod_insruction)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: rating ~ instruction * wave + (1 + instruction * wave | subjectID)
## Data: data_diss_craving
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 37746.3
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.9322 -0.6647 0.0183 0.6678 4.0244
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## subjectID (Intercept) 0.2131 0.4616
## instructionregulate 0.2783 0.5276 -0.45
## wave2 0.3367 0.5802 -0.17 0.00
## instructionregulate:wave2 0.1964 0.4432 -0.09 -0.31 -0.62
## Residual 0.4500 0.6708
## Number of obs: 17490, groups: subjectID, 263
##
## Fixed effects:
## Estimate Std. Error df t value
## (Intercept) 3.26627 0.03091 252.93493 105.684
## instructionregulate -0.93565 0.03610 251.63019 -25.918
## wave2 -0.59311 0.04322 210.72697 -13.724
## instructionregulate:wave2 0.10125 0.03748 218.23422 2.701
## Pr(>|t|)
## (Intercept) < 0.0000000000000002 ***
## instructionregulate < 0.0000000000000002 ***
## wave2 < 0.0000000000000002 ***
## instructionregulate:wave2 0.00745 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) instrc wave2
## instrctnrgl -0.480
## wave2 -0.242 0.075
## instrctnr:2 0.043 -0.384 -0.630craving
brain ~ instruction x wave
expression is weaker when regulating
the intervention decreased expression
tidytable
mod_instruction = lmer(dotProduct ~ instruction * wave + (1 + instruction * wave | subjectID),
data = data_diss_craving,
control = lmerControl(optimizer = "bobyqa"))
table_model(mod_instruction)| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| (Intercept) | 2.46 [1.95, 2.97] | 254.80 | 9.48 | < .001 |
| instruction (regulate) | -1.32 [-1.80, -0.83] | 248.02 | -5.32 | < .001 |
| wave (post) | -0.53 [-1.12, 0.06] | 228.84 | -1.75 | .080 |
| instruction (regulate) x wave (post) | -0.06 [-0.70, 0.57] | 233.63 | -0.19 | .850 |
plot
ggeffects::ggpredict(mod_instruction, terms = c("wave", "instruction")) %>%
data.frame() %>%
ggplot(aes(x, predicted, color = group, fill = group)) +
geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
geom_line(aes(group = group)) +
scale_color_manual(name = "", values = instruction) +
scale_fill_manual(name = "", values = instruction) +
labs(x = "\nwave", y = "predicted pattern expression value\n") +
dc_bw
model summary
summary(mod_instruction)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: dotProduct ~ instruction * wave + (1 + instruction * wave | subjectID)
## Data: data_diss_craving
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 134857
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -6.9698 -0.6021 0.0080 0.5954 9.6941
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## subjectID (Intercept) 12.042 3.470
## instructionregulate 5.409 2.326 0.10
## wave2 9.783 3.128 -0.45 0.03
## instructionregulate:wave2 3.415 1.848 0.32 -0.23 -0.71
## Residual 96.525 9.825
## Number of obs: 18079, groups: subjectID, 265
##
## Fixed effects:
## Estimate Std. Error df t value
## (Intercept) 2.45804 0.25915 254.80444 9.485
## instructionregulate -1.31528 0.24732 248.01525 -5.318
## wave2 -0.52628 0.29990 228.84184 -1.755
## instructionregulate:wave2 -0.06154 0.32298 233.63326 -0.191
## Pr(>|t|)
## (Intercept) < 0.0000000000000002 ***
## instructionregulate 0.000000234 ***
## wave2 0.0806 .
## instructionregulate:wave2 0.8491
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) instrc wave2
## instrctnrgl -0.267
## wave2 -0.520 0.282
## instrctnr:2 0.333 -0.558 -0.638craving ~ brain x wave
between-person: people who on average have higher expression, tend to report higher cravings
within-person: trials with higher than average expression are associated with higher craving ratings
tidy table
mod_craving = lmer(rating ~ dot_between * wave + dot_within * wave + (1 + dot_within * wave | subjectID),
data = data_diss_craving,
control = lmerControl(optimizer = "bobyqa"))
table_model(mod_craving)| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| (Intercept) | 2.79 [2.74, 2.85] | 249.58 | 99.72 | < .001 |
| between | 0.02 [-0.02, 0.06] | 257.76 | 0.82 | .410 |
| wave (post) | -0.53 [-0.60, -0.46] | 216.83 | -15.23 | < .001 |
| within | 0.07 [0.04, 0.09] | 238.10 | 6.28 | < .001 |
| between x wave (post) | 0.03 [-0.03, 0.09] | 245.23 | 0.83 | .410 |
| wave (post) x within | 0.02 [-0.00, 0.05] | 230.01 | 1.69 | .090 |
plot
by wave
vals = seq(-6, 6, .2)
ggeffects::ggpredict(mod_craving, terms = c("dot_between[vals]", "wave")) %>%
data.frame() %>%
mutate(type = "between-person") %>%
bind_rows(ggeffects::ggpredict(mod_craving, terms = c("dot_within[vals]", "wave")) %>%
data.frame() %>%
mutate(type = "within-person")) %>%
ggplot(aes(x, predicted, color = group, fill = group)) +
geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .5, color = NA) +
geom_line(aes(group = group)) +
facet_grid(~type) +
scale_color_manual(name = "wave", values = algorithm) +
scale_fill_manual(name = "wave", values = algorithm) +
labs(x = "\npredicted pattern expression value", y = "predicted craving rating\n") +
dc_bw
by expression
ggeffects::ggpredict(mod_craving, terms = c("wave", "dot_between [-1, 0, 1]")) %>%
data.frame() %>%
mutate(type = "between-person") %>%
bind_rows(ggeffects::ggpredict(mod_craving, terms = c("wave", "dot_within [-1, 0, 1]")) %>%
data.frame() %>%
mutate(type = "within-person")) %>%
ggplot(aes(x, predicted, color = group, fill = group)) +
geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
geom_line(aes(group = group)) +
facet_grid(~type) +
scale_color_manual(name = "expression", values = algorithm) +
scale_fill_manual(name = "expression", values = algorithm) +
labs(x = "\nwave", y = "predicted craving rating\n") +
dc_bw
model summary
summary(mod_craving)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: rating ~ dot_between * wave + dot_within * wave + (1 + dot_within *
## wave | subjectID)
## Data: data_diss_craving
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 44518.4
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.12926 -0.72806 -0.04803 0.73580 3.02315
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## subjectID (Intercept) 0.173807 0.41690
## dot_within 0.006249 0.07905 -0.27
## wave2 0.214557 0.46320 -0.37 0.13
## dot_within:wave2 0.006546 0.08091 0.30 -0.17 -0.01
## Residual 0.727419 0.85289
## Number of obs: 17175, groups: subjectID, 263
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 2.79483 0.02803 249.58231 99.721 < 0.0000000000000002
## dot_between 0.01762 0.02143 257.75721 0.822 0.4116
## wave2 -0.53202 0.03494 216.82767 -15.227 < 0.0000000000000002
## dot_within 0.06516 0.01038 238.10318 6.280 0.00000000159
## dot_between:wave2 0.02531 0.03056 245.23341 0.828 0.4083
## wave2:dot_within 0.02458 0.01456 230.00543 1.688 0.0928
##
## (Intercept) ***
## dot_between
## wave2 ***
## dot_within ***
## dot_between:wave2
## wave2:dot_within .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) dt_btw wave2 dt_wth dt_b:2
## dot_between -0.093
## wave2 -0.413 0.083
## dot_within -0.126 0.000 0.057
## dt_btwn:wv2 0.039 -0.469 -0.010 0.000
## wv2:dt_wthn 0.099 0.000 0.000 -0.581 -0.001craving ~ brain x instruction x wave
no 3-way interactions
tidy table
mod_rating_craving = lmer(rating ~ dot_between*instruction*wave + dot_within*instruction*wave +
(1 + dot_within * instruction + instruction * wave | subjectID),
data = data_diss_craving,
control = lmerControl(optimizer = "bobyqa"))
table_model(mod_rating_craving)| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| (Intercept) | 3.26 [3.20, 3.32] | 251.87 | 104.69 | < .001 |
| between | 0.04 [-0.00, 0.09] | 255.85 | 1.85 | .070 |
| instruction (regulate) | -0.93 [-1.00, -0.86] | 250.51 | -25.69 | < .001 |
| wave (post) | -0.59 [-0.67, -0.50] | 211.75 | -13.61 | < .001 |
| within | 0.01 [-0.01, 0.03] | 616.87 | 1.08 | .280 |
| between x instruction (regulate) | -0.04 [-0.09, 0.02] | 273.70 | -1.35 | .180 |
| between x wave (post) | 0.03 [-0.05, 0.10] | 228.52 | 0.70 | .480 |
| instruction (regulate) x wave (post) | 0.10 [0.02, 0.17] | 221.02 | 2.58 | .010 |
| instruction (regulate) x within | 0.03 [0.00, 0.06] | 723.10 | 1.99 | .050 |
| wave (post) x within | 0.02 [-0.01, 0.05] | 9911.42 | 1.45 | .150 |
| between x instruction (regulate) x wave (post) | -0.01 [-0.07, 0.06] | 241.97 | -0.29 | .770 |
| instruction (regulate) x wave (post) x within | -0.01 [-0.05, 0.04] | 12360.44 | -0.33 | .740 |
plot
by wave
vals = seq(-6, 6, .2)
ggeffects::ggpredict(mod_rating_craving, terms = c("dot_between[vals]", "wave", "instruction")) %>%
data.frame() %>%
mutate(type = "between-person") %>%
bind_rows(ggeffects::ggpredict(mod_rating_craving, terms = c("dot_within[vals]", "wave", "instruction")) %>%
data.frame() %>%
mutate(type = "within-person")) %>%
ggplot(aes(x, predicted, color = group, fill = group)) +
geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .5, color = NA) +
geom_line(aes(group = group)) +
facet_grid(type~facet) +
scale_color_manual(name = "wave", values = algorithm) +
scale_fill_manual(name = "wave", values = algorithm) +
labs(x = "\npattern expression value", y = "predicted craving rating\n") +
dc_bw
by expression
ggeffects::ggpredict(mod_rating_craving, terms = c("wave", "dot_between [-1, 0, 1]", "instruction")) %>%
data.frame() %>%
mutate(type = "between-person") %>%
bind_rows(ggeffects::ggpredict(mod_rating_craving, terms = c("wave", "dot_within [-1, 0, 1]", "instruction")) %>%
data.frame() %>%
mutate(type = "within-person")) %>%
ggplot(aes(x, predicted, color = group, fill = group)) +
geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
geom_line(aes(group = group)) +
facet_grid(type~facet) +
scale_color_manual(name = "expression", values = algorithm) +
scale_fill_manual(name = "expression", values = algorithm) +
labs(x = "\nwave", y = "predicted bid value\n") +
dc_bw
model summary
summary(mod_rating_craving)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula:
## rating ~ dot_between * instruction * wave + dot_within * instruction *
## wave + (1 + dot_within * instruction + instruction * wave | subjectID)
## Data: data_diss_craving
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 37078.7
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.9635 -0.6614 0.0178 0.6614 4.0454
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## subjectID (Intercept) 0.214700 0.46336
## dot_within 0.003767 0.06138 -0.31
## instructionregulate 0.276739 0.52606 -0.44 -0.03
## wave2 0.329620 0.57413 -0.17 0.03 -0.01
## dot_within:instructionregulate 0.004945 0.07032 0.19 -0.83 0.13
## instructionregulate:wave2 0.195041 0.44163 -0.08 0.07 -0.31
## Residual 0.446465 0.66818
##
##
##
##
##
## -0.12
## -0.60 0.11
##
## Number of obs: 17175, groups: subjectID, 263
##
## Fixed effects:
## Estimate Std. Error df
## (Intercept) 3.261554 0.031155 251.872662
## dot_between 0.043257 0.023396 255.854354
## instructionregulate -0.930597 0.036219 250.507886
## wave2 -0.585526 0.043021 211.747347
## dot_within 0.011973 0.011054 616.871130
## dot_between:instructionregulate -0.035193 0.026138 273.698588
## dot_between:wave2 0.026483 0.037622 228.524922
## instructionregulate:wave2 0.097307 0.037739 221.020985
## instructionregulate:dot_within 0.030408 0.015245 723.102116
## wave2:dot_within 0.022246 0.015322 9911.424609
## dot_between:instructionregulate:wave2 -0.009511 0.032929 241.971245
## instructionregulate:wave2:dot_within -0.007073 0.021471 12360.444450
## t value Pr(>|t|)
## (Intercept) 104.689 <0.0000000000000002 ***
## dot_between 1.849 0.0656 .
## instructionregulate -25.693 <0.0000000000000002 ***
## wave2 -13.610 <0.0000000000000002 ***
## dot_within 1.083 0.2792
## dot_between:instructionregulate -1.346 0.1793
## dot_between:wave2 0.704 0.4822
## instructionregulate:wave2 2.578 0.0106 *
## instructionregulate:dot_within 1.995 0.0465 *
## wave2:dot_within 1.452 0.1466
## dot_between:instructionregulate:wave2 -0.289 0.7730
## instructionregulate:wave2:dot_within -0.329 0.7418
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) dt_btw instrc wave2 dt_wth dt_bt: dt_b:2 inst:2 inst:_
## dot_between -0.088
## instrctnrgl -0.473 0.037
## wave2 -0.251 0.074 0.075
## dot_within -0.128 0.015 0.012 0.034
## dt_btwn:nst 0.039 -0.455 -0.090 -0.034 -0.012
## dt_btwn:wv2 0.024 -0.350 -0.006 0.008 -0.012 0.135
## instrctnr:2 0.056 -0.045 -0.395 -0.619 -0.007 0.098 -0.011
## instrctnr:_ 0.071 -0.010 0.031 -0.046 -0.722 -0.001 0.009 0.026
## wv2:dt_wthn 0.023 -0.015 -0.016 -0.037 -0.637 0.014 0.016 0.035 0.463
## dt_btwn:n:2 -0.006 0.141 0.035 -0.014 0.013 -0.476 -0.621 -0.013 0.000
## instrct:2:_ -0.016 0.010 0.002 0.022 0.456 0.002 -0.011 0.005 -0.652
## wv2:d_ dt_::2
## dot_between
## instrctnrgl
## wave2
## dot_within
## dt_btwn:nst
## dt_btwn:wv2
## instrctnr:2
## instrctnr:_
## wv2:dt_wthn
## dt_btwn:n:2 -0.019
## instrct:2:_ -0.716 -0.002Koban craving
brain ~ instruction x wave
expression is weaker when regulating
the intervention decreased expression when looking, but not when regulating
tidytable
mod_instruction = lmer(dotProduct ~ instruction * wave + (1 + instruction * wave | subjectID),
data = data_diss_craving_koban,
control = lmerControl(optimizer = "bobyqa"))
table_model(mod_instruction)| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| (Intercept) | 1.49 [1.18, 1.80] | 260.42 | 9.42 | < .001 |
| instruction (regulate) | -1.30 [-1.57, -1.04] | 241.09 | -9.61 | < .001 |
| wave (post) | -0.38 [-0.71, -0.05] | 217.95 | -2.28 | .020 |
| instruction (regulate) x wave (post) | 0.32 [-0.09, 0.73] | 232.63 | 1.56 | .120 |
plot
ggeffects::ggpredict(mod_instruction, terms = c("wave", "instruction")) %>%
data.frame() %>%
ggplot(aes(x, predicted, color = group, fill = group)) +
geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
geom_line(aes(group = group)) +
scale_color_manual(name = "", values = instruction) +
scale_fill_manual(name = "", values = instruction) +
labs(x = "\nwave", y = "predicted pattern expression value\n") +
dc_bw
model summary
summary(mod_instruction)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: dotProduct ~ instruction * wave + (1 + instruction * wave | subjectID)
## Data: data_diss_craving_koban
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 117473.8
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -12.6833 -0.5967 -0.0068 0.6006 5.1906
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## subjectID (Intercept) 4.451 2.1098
## instructionregulate 0.783 0.8849 -0.41
## wave2 2.023 1.4223 -0.12 -0.12
## instructionregulate:wave2 1.971 1.4041 -0.13 0.09 -0.49
## Residual 37.138 6.0941
## Number of obs: 18079, groups: subjectID, 265
##
## Fixed effects:
## Estimate Std. Error df t value
## (Intercept) 1.4890 0.1580 260.4226 9.423
## instructionregulate -1.3038 0.1357 241.0904 -9.608
## wave2 -0.3795 0.1662 217.9524 -2.283
## instructionregulate:wave2 0.3236 0.2079 232.6302 1.556
## Pr(>|t|)
## (Intercept) <0.0000000000000002 ***
## instructionregulate <0.0000000000000002 ***
## wave2 0.0234 *
## instructionregulate:wave2 0.1210
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) instrc wave2
## instrctnrgl -0.494
## wave2 -0.366 0.320
## instrctnr:2 0.191 -0.534 -0.633craving ~ brain x wave
between-person: average expression isn’t associated with craving ratings
within-person: trials with higher than average expression are associated with higher craving ratings
people with higher than average expression show weaker intervention effects (i.e., smaller decreases)
tidy table
mod_craving = lmer(rating ~ dot_between * wave + dot_within * wave + (1 + dot_within * wave | subjectID),
data = data_diss_craving_koban,
control = lmerControl(optimizer = "bobyqa"))
table_model(mod_craving)| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| (Intercept) | 2.81 [2.75, 2.86] | 250.73 | 98.55 | < .001 |
| between | 0.04 [-0.04, 0.12] | 257.63 | 1.04 | .300 |
| wave (post) | -0.52 [-0.59, -0.45] | 214.33 | -14.54 | < .001 |
| within | 0.13 [0.11, 0.16] | 244.58 | 12.30 | < .001 |
| between x wave (post) | 0.06 [-0.04, 0.17] | 246.71 | 1.16 | .250 |
| wave (post) x within | -0.02 [-0.05, 0.01] | 241.20 | -1.12 | .260 |
plot
by wave
vals = seq(-6, 6, .2)
ggeffects::ggpredict(mod_craving, terms = c("dot_between[vals]", "wave")) %>%
data.frame() %>%
mutate(type = "between-person") %>%
bind_rows(ggeffects::ggpredict(mod_craving, terms = c("dot_within[vals]", "wave")) %>%
data.frame() %>%
mutate(type = "within-person")) %>%
ggplot(aes(x, predicted, color = group, fill = group)) +
geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .5, color = NA) +
geom_line(aes(group = group)) +
facet_grid(~type) +
scale_color_manual(name = "wave", values = algorithm) +
scale_fill_manual(name = "wave", values = algorithm) +
labs(x = "\npredicted pattern expression value", y = "predicted craving rating\n") +
dc_bw
by expression
ggeffects::ggpredict(mod_craving, terms = c("wave", "dot_between [-1, 0, 1]")) %>%
data.frame() %>%
mutate(type = "between-person") %>%
bind_rows(ggeffects::ggpredict(mod_craving, terms = c("wave", "dot_within [-1, 0, 1]")) %>%
data.frame() %>%
mutate(type = "within-person")) %>%
ggplot(aes(x, predicted, color = group, fill = group)) +
geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
geom_line(aes(group = group)) +
facet_grid(~type) +
scale_color_manual(name = "expression", values = algorithm) +
scale_fill_manual(name = "expression", values = algorithm) +
labs(x = "\nwave", y = "predicted craving rating\n") +
dc_bw
model summary
summary(mod_craving)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: rating ~ dot_between * wave + dot_within * wave + (1 + dot_within *
## wave | subjectID)
## Data: data_diss_craving_koban
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 44262.5
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.13447 -0.72412 -0.04339 0.75127 3.03730
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## subjectID (Intercept) 0.173391 0.41640
## dot_within 0.009548 0.09771 -0.19
## wave2 0.214132 0.46274 -0.38 0.05
## dot_within:wave2 0.011684 0.10809 0.22 -0.56 0.34
## Residual 0.715996 0.84617
## Number of obs: 17175, groups: subjectID, 263
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 2.80515 0.02846 250.72597 98.551 <0.0000000000000002
## dot_between 0.04214 0.04055 257.62504 1.039 0.300
## wave2 -0.52258 0.03593 214.32542 -14.544 <0.0000000000000002
## dot_within 0.13455 0.01094 244.57931 12.298 <0.0000000000000002
## dot_between:wave2 0.06151 0.05299 246.71100 1.161 0.247
## wave2:dot_within -0.01693 0.01511 241.20142 -1.120 0.264
##
## (Intercept) ***
## dot_between
## wave2 ***
## dot_within ***
## dot_between:wave2
## wave2:dot_within
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) dt_btw wave2 dt_wth dt_b:2
## dot_between 0.207
## wave2 -0.406 -0.080
## dot_within -0.098 0.000 0.023
## dt_btwn:wv2 -0.110 -0.539 0.250 0.000
## wv2:dt_wthn 0.090 0.001 0.151 -0.640 0.002craving ~ brain x instruction x wave
no 3-way interactions
tidy table
mod_rating_craving = lmer(rating ~ dot_between*instruction*wave + dot_within*instruction*wave +
(1 + dot_within * instruction + instruction * wave | subjectID),
data = data_diss_craving_koban,
control = lmerControl(optimizer = "bobyqa"))
table_model(mod_rating_craving)| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| (Intercept) | 3.27 [3.20, 3.33] | 251.99 | 103.58 | < .001 |
| between | 0.06 [-0.02, 0.15] | 256.59 | 1.45 | .150 |
| instruction (regulate) | -0.93 [-1.00, -0.86] | 253.18 | -25.38 | < .001 |
| wave (post) | -0.57 [-0.65, -0.48] | 208.98 | -12.79 | < .001 |
| within | 0.10 [0.08, 0.12] | 618.96 | 9.40 | < .001 |
| between x instruction (regulate) | -0.05 [-0.14, 0.05] | 278.01 | -0.95 | .340 |
| between x wave (post) | 0.08 [-0.05, 0.21] | 225.30 | 1.25 | .210 |
| instruction (regulate) x wave (post) | 0.09 [0.01, 0.17] | 215.32 | 2.31 | .020 |
| instruction (regulate) x within | -0.06 [-0.09, -0.03] | 780.66 | -3.73 | < .001 |
| wave (post) x within | -0.00 [-0.03, 0.03] | 10466.53 | -0.16 | .880 |
| between x instruction (regulate) x wave (post) | -0.01 [-0.13, 0.10] | 245.92 | -0.24 | .810 |
| instruction (regulate) x wave (post) x within | 0.01 [-0.04, 0.05] | 12825.25 | 0.31 | .760 |
plot
by wave
vals = seq(-6, 6, .2)
ggeffects::ggpredict(mod_rating_craving, terms = c("dot_between[vals]", "wave", "instruction")) %>%
data.frame() %>%
mutate(type = "between-person") %>%
bind_rows(ggeffects::ggpredict(mod_rating_craving, terms = c("dot_within[vals]", "wave", "instruction")) %>%
data.frame() %>%
mutate(type = "within-person")) %>%
ggplot(aes(x, predicted, color = group, fill = group)) +
geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .5, color = NA) +
geom_line(aes(group = group)) +
facet_grid(type~facet) +
scale_color_manual(name = "wave", values = algorithm) +
scale_fill_manual(name = "wave", values = algorithm) +
labs(x = "\npattern expression value", y = "predicted craving rating\n") +
dc_bw
by expression
ggeffects::ggpredict(mod_rating_craving, terms = c("wave", "dot_between [-1, 0, 1]", "instruction")) %>%
data.frame() %>%
mutate(type = "between-person") %>%
bind_rows(ggeffects::ggpredict(mod_rating_craving, terms = c("wave", "dot_within [-1, 0, 1]", "instruction")) %>%
data.frame() %>%
mutate(type = "within-person")) %>%
ggplot(aes(x, predicted, color = group, fill = group)) +
geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
geom_line(aes(group = group)) +
facet_grid(type~facet) +
scale_color_manual(name = "expression", values = algorithm) +
scale_fill_manual(name = "expression", values = algorithm) +
labs(x = "\nwave", y = "predicted bid value\n") +
dc_bw
model summary
summary(mod_rating_craving)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula:
## rating ~ dot_between * instruction * wave + dot_within * instruction *
## wave + (1 + dot_within * instruction + instruction * wave | subjectID)
## Data: data_diss_craving_koban
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 36912.3
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.9512 -0.6564 0.0162 0.6569 4.0092
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## subjectID (Intercept) 0.212731 0.46123
## dot_within 0.002975 0.05454 -0.12
## instructionregulate 0.273611 0.52308 -0.44 -0.01
## wave2 0.327295 0.57210 -0.17 0.11 0.00
## dot_within:instructionregulate 0.003211 0.05666 0.19 -0.67 -0.10
## instructionregulate:wave2 0.197395 0.44429 -0.09 -0.18 -0.31
## Residual 0.442159 0.66495
##
##
##
##
##
## 0.15
## -0.61 0.07
##
## Number of obs: 17175, groups: subjectID, 263
##
## Fixed effects:
## Estimate Std. Error df
## (Intercept) 3.266276 0.031534 251.994314
## dot_between 0.064016 0.044236 256.592044
## instructionregulate -0.928494 0.036578 253.178468
## wave2 -0.566867 0.044333 208.976082
## dot_within 0.099925 0.010628 618.958725
## dot_between:instructionregulate -0.047182 0.049432 278.006417
## dot_between:wave2 0.081566 0.065326 225.302439
## instructionregulate:wave2 0.089826 0.038895 215.316155
## instructionregulate:dot_within -0.055787 0.014947 780.656299
## wave2:dot_within -0.002312 0.014859 10466.525932
## dot_between:instructionregulate:wave2 -0.014099 0.058728 245.920318
## instructionregulate:wave2:dot_within 0.006578 0.021298 12825.253156
## t value Pr(>|t|)
## (Intercept) 103.579 < 0.0000000000000002 ***
## dot_between 1.447 0.149079
## instructionregulate -25.384 < 0.0000000000000002 ***
## wave2 -12.787 < 0.0000000000000002 ***
## dot_within 9.402 < 0.0000000000000002 ***
## dot_between:instructionregulate -0.954 0.340674
## dot_between:wave2 1.249 0.213104
## instructionregulate:wave2 2.309 0.021866 *
## instructionregulate:dot_within -3.732 0.000203 ***
## wave2:dot_within -0.156 0.876351
## dot_between:instructionregulate:wave2 -0.240 0.810475
## instructionregulate:wave2:dot_within 0.309 0.757441
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) dt_btw instrc wave2 dt_wth dt_bt: dt_b:2 inst:2 inst:_
## dot_between 0.200
## instrctnrgl -0.469 -0.084
## wave2 -0.236 -0.040 0.073
## dot_within -0.072 -0.003 0.028 0.057
## dt_btwn:nst -0.087 -0.446 0.192 0.008 0.003
## dt_btwn:wv2 -0.077 -0.398 0.028 0.260 0.002 0.157
## instrctnr:2 0.038 -0.005 -0.380 -0.625 -0.073 -0.063 -0.159
## instrctnr:_ 0.065 0.003 -0.019 0.009 -0.690 0.000 -0.002 0.012
## wv2:dt_wthn 0.027 0.002 -0.023 -0.034 -0.643 -0.004 -0.005 0.034 0.458
## dt_btwn:n:2 0.027 0.152 -0.100 -0.159 -0.003 -0.534 -0.600 0.244 -0.001
## instrct:2:_ -0.018 -0.002 -0.001 0.031 0.450 0.000 0.004 0.001 -0.663
## wv2:d_ dt_::2
## dot_between
## instrctnrgl
## wave2
## dot_within
## dt_btwn:nst
## dt_btwn:wv2
## instrctnr:2
## instrctnr:_
## wv2:dt_wthn
## dt_btwn:n:2 0.006
## instrct:2:_ -0.698 0.002craving regulation
brain ~ instruction x wave
expression is stronger when regulating
the intervention increased expression when looking and decreased expression when regulating
tidytable
mod_instruction = lmer(dotProduct ~ instruction * wave + (1 + instruction * wave | subjectID),
data = data_diss_regulation,
control = lmerControl(optimizer = "bobyqa"))
table_model(mod_instruction)| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| (Intercept) | -2.59 [-3.00, -2.17] | 255.97 | -12.17 | < .001 |
| instruction (regulate) | 8.50 [7.96, 9.04] | 250.30 | 30.90 | < .001 |
| wave (post) | 0.75 [0.29, 1.22] | 229.53 | 3.18 | < .001 |
| instruction (regulate) x wave (post) | -1.16 [-1.76, -0.57] | 220.23 | -3.86 | < .001 |
plot
ggeffects::ggpredict(mod_instruction, terms = c("wave", "instruction")) %>%
data.frame() %>%
ggplot(aes(x, predicted, color = group, fill = group)) +
geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
geom_line(aes(group = group)) +
scale_color_manual(name = "", values = instruction) +
scale_fill_manual(name = "", values = instruction) +
labs(x = "\nwave", y = "predicted pattern expression value\n") +
dc_bw
model summary
summary(mod_instruction)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: dotProduct ~ instruction * wave + (1 + instruction * wave | subjectID)
## Data: data_diss_regulation
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 127494.5
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -6.2752 -0.6117 0.0019 0.6162 5.6498
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## subjectID (Intercept) 8.131 2.851
## instructionregulate 12.610 3.551 -0.15
## wave2 5.599 2.366 -0.38 0.17
## instructionregulate:wave2 6.575 2.564 0.04 -0.35 -0.37
## Residual 63.280 7.955
## Number of obs: 18079, groups: subjectID, 265
##
## Fixed effects:
## Estimate Std. Error df t value
## (Intercept) -2.5851 0.2125 255.9745 -12.168
## instructionregulate 8.4983 0.2750 250.3038 30.900
## wave2 0.7541 0.2371 229.5291 3.180
## instructionregulate:wave2 -1.1643 0.3019 220.2288 -3.857
## Pr(>|t|)
## (Intercept) < 0.0000000000000002 ***
## instructionregulate < 0.0000000000000002 ***
## wave2 0.001674 **
## instructionregulate:wave2 0.000151 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) instrc wave2
## instrctnrgl -0.332
## wave2 -0.485 0.291
## instrctnr:2 0.232 -0.488 -0.555craving ~ brain x wave
between-person: average expression isn’t related to craving ratings
within-person: trials with higher than average expression are associated with lower craving ratings
tidy table
mod_craving = lmer(rating ~ dot_between * wave + dot_within * wave + (1 + dot_within * wave | subjectID),
data = data_diss_regulation,
control = lmerControl(optimizer = "bobyqa"))
table_model(mod_craving)| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| (Intercept) | 2.80 [2.74, 2.85] | 248.90 | 100.80 | < .001 |
| between | 0.01 [-0.04, 0.06] | 251.37 | 0.47 | .640 |
| wave (post) | -0.53 [-0.60, -0.46] | 214.45 | -15.01 | < .001 |
| within | -0.25 [-0.27, -0.22] | 249.42 | -19.47 | < .001 |
| between x wave (post) | -0.06 [-0.13, 0.00] | 241.29 | -1.86 | .060 |
| wave (post) x within | 0.03 [-0.00, 0.06] | 225.48 | 1.96 | .050 |
plot
by wave
vals = seq(-6, 6, .2)
ggeffects::ggpredict(mod_craving, terms = c("dot_between[vals]", "wave")) %>%
data.frame() %>%
mutate(type = "between-person") %>%
bind_rows(ggeffects::ggpredict(mod_craving, terms = c("dot_within[vals]", "wave")) %>%
data.frame() %>%
mutate(type = "within-person")) %>%
ggplot(aes(x, predicted, color = group, fill = group)) +
geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .5, color = NA) +
geom_line(aes(group = group)) +
facet_grid(~type) +
scale_color_manual(name = "wave", values = algorithm) +
scale_fill_manual(name = "wave", values = algorithm) +
labs(x = "\npredicted pattern expression value", y = "predicted craving rating\n") +
dc_bw
by expression
ggeffects::ggpredict(mod_craving, terms = c("wave", "dot_between [-1, 0, 1]")) %>%
data.frame() %>%
mutate(type = "between-person") %>%
bind_rows(ggeffects::ggpredict(mod_craving, terms = c("wave", "dot_within [-1, 0, 1]")) %>%
data.frame() %>%
mutate(type = "within-person")) %>%
ggplot(aes(x, predicted, color = group, fill = group)) +
geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
geom_line(aes(group = group)) +
facet_grid(~type) +
scale_color_manual(name = "expression", values = algorithm) +
scale_fill_manual(name = "expression", values = algorithm) +
labs(x = "\nwave", y = "predicted craving rating\n") +
dc_bw
model summary
summary(mod_craving)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: rating ~ dot_between * wave + dot_within * wave + (1 + dot_within *
## wave | subjectID)
## Data: data_diss_regulation
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 43037.4
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.3267 -0.6919 -0.0334 0.7086 3.1697
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## subjectID (Intercept) 0.17210 0.4149
## dot_within 0.02116 0.1455 -0.01
## wave2 0.21722 0.4661 -0.36 -0.10
## dot_within:wave2 0.01542 0.1242 -0.27 -0.09 -0.46
## Residual 0.65868 0.8116
## Number of obs: 17175, groups: subjectID, 263
##
## Fixed effects:
## Estimate Std. Error df t value Pr(>|t|)
## (Intercept) 2.79598 0.02774 248.90361 100.797 <0.0000000000000002
## dot_between 0.01188 0.02550 251.37467 0.466 0.6418
## wave2 -0.52827 0.03518 214.45366 -15.014 <0.0000000000000002
## dot_within -0.24596 0.01263 249.41536 -19.469 <0.0000000000000002
## dot_between:wave2 -0.06300 0.03394 241.28877 -1.857 0.0646
## wave2:dot_within 0.03060 0.01564 225.47674 1.956 0.0517
##
## (Intercept) ***
## dot_between
## wave2 ***
## dot_within ***
## dot_between:wave2 .
## wave2:dot_within .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) dt_btw wave2 dt_wth dt_b:2
## dot_between -0.083
## wave2 -0.393 0.046
## dot_within -0.006 0.001 -0.055
## dt_btwn:wv2 0.045 -0.534 -0.151 0.000
## wv2:dt_wthn -0.118 -0.007 -0.248 -0.433 0.002craving ~ brain x instruction x wave
no 3-way interactions
tidy table
mod_rating_craving = lmer(rating ~ dot_between*instruction*wave + dot_within*instruction*wave +
(1 + dot_within * instruction + instruction * wave | subjectID),
data = data_diss_regulation,
control = lmerControl(optimizer = "bobyqa"))
table_model(mod_rating_craving)| term | b [95% CI] | df | t | p |
|---|---|---|---|---|
| (Intercept) | 3.25 [3.19, 3.31] | 260.07 | 103.29 | < .001 |
| between | 0.03 [-0.03, 0.08] | 250.82 | 0.94 | .350 |
| instruction (regulate) | -0.92 [-0.99, -0.84] | 261.39 | -24.79 | < .001 |
| wave (post) | -0.59 [-0.68, -0.50] | 219.84 | -13.27 | < .001 |
| within | -0.03 [-0.06, -0.01] | 590.74 | -2.58 | .010 |
| between x instruction (regulate) | -0.03 [-0.09, 0.03] | 270.93 | -1.07 | .290 |
| between x wave (post) | -0.07 [-0.16, 0.02] | 224.10 | -1.57 | .120 |
| instruction (regulate) x wave (post) | 0.10 [0.02, 0.17] | 253.70 | 2.46 | .010 |
| instruction (regulate) x within | 0.03 [-0.01, 0.06] | 716.53 | 1.57 | .120 |
| wave (post) x within | -0.02 [-0.06, 0.01] | 8557.95 | -1.26 | .210 |
| between x instruction (regulate) x wave (post) | 0.04 [-0.04, 0.11] | 241.91 | 0.93 | .350 |
| instruction (regulate) x wave (post) x within | 0.04 [-0.00, 0.09] | 11658.26 | 1.80 | .070 |
plot
by wave
vals = seq(-6, 6, .2)
ggeffects::ggpredict(mod_rating_craving, terms = c("dot_between[vals]", "wave", "instruction")) %>%
data.frame() %>%
mutate(type = "between-person") %>%
bind_rows(ggeffects::ggpredict(mod_rating_craving, terms = c("dot_within[vals]", "wave", "instruction")) %>%
data.frame() %>%
mutate(type = "within-person")) %>%
ggplot(aes(x, predicted, color = group, fill = group)) +
geom_ribbon(aes(ymin = conf.low, ymax = conf.high), alpha = .5, color = NA) +
geom_line(aes(group = group)) +
facet_grid(type~facet) +
scale_color_manual(name = "wave", values = algorithm) +
scale_fill_manual(name = "wave", values = algorithm) +
labs(x = "\npattern expression value", y = "predicted craving rating\n") +
dc_bw
by expression
ggeffects::ggpredict(mod_rating_craving, terms = c("wave", "dot_between [-1, 0, 1]", "instruction")) %>%
data.frame() %>%
mutate(type = "between-person") %>%
bind_rows(ggeffects::ggpredict(mod_rating_craving, terms = c("wave", "dot_within [-1, 0, 1]", "instruction")) %>%
data.frame() %>%
mutate(type = "within-person")) %>%
ggplot(aes(x, predicted, color = group, fill = group)) +
geom_pointrange(aes(ymin = conf.low, ymax = conf.high)) +
geom_line(aes(group = group)) +
facet_grid(type~facet) +
scale_color_manual(name = "expression", values = algorithm) +
scale_fill_manual(name = "expression", values = algorithm) +
labs(x = "\nwave", y = "predicted bid value\n") +
dc_bw
model summary
summary(mod_rating_craving)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula:
## rating ~ dot_between * instruction * wave + dot_within * instruction *
## wave + (1 + dot_within * instruction + instruction * wave | subjectID)
## Data: data_diss_regulation
## Control: lmerControl(optimizer = "bobyqa")
##
## REML criterion at convergence: 37104.8
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.9151 -0.6696 0.0192 0.6654 4.0473
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## subjectID (Intercept) 0.212127 0.46057
## dot_within 0.006012 0.07754 0.07
## instructionregulate 0.277867 0.52713 -0.43 0.03
## wave2 0.333225 0.57726 -0.17 0.07 0.00
## dot_within:instructionregulate 0.009336 0.09662 -0.18 -0.98 -0.02
## instructionregulate:wave2 0.195280 0.44191 -0.11 -0.16 -0.31
## Residual 0.447378 0.66886
##
##
##
##
##
## -0.17
## -0.61 0.34
##
## Number of obs: 17175, groups: subjectID, 263
##
## Fixed effects:
## Estimate Std. Error df
## (Intercept) 3.24980 0.03146 260.06560
## dot_between 0.02628 0.02799 250.81903
## instructionregulate -0.91709 0.03700 261.38706
## wave2 -0.58899 0.04440 219.83569
## dot_within -0.03337 0.01292 590.73639
## dot_between:instructionregulate -0.03328 0.03112 270.92658
## dot_between:wave2 -0.06897 0.04380 224.09837
## instructionregulate:wave2 0.09700 0.03936 253.69774
## instructionregulate:dot_within 0.02768 0.01766 716.53149
## wave2:dot_within -0.02211 0.01758 8557.95142
## dot_between:instructionregulate:wave2 0.03565 0.03822 241.90730
## instructionregulate:wave2:dot_within 0.04357 0.02419 11658.26287
## t value Pr(>|t|)
## (Intercept) 103.288 <0.0000000000000002 ***
## dot_between 0.939 0.3488
## instructionregulate -24.789 <0.0000000000000002 ***
## wave2 -13.266 <0.0000000000000002 ***
## dot_within -2.583 0.0100 *
## dot_between:instructionregulate -1.070 0.2858
## dot_between:wave2 -1.575 0.1167
## instructionregulate:wave2 2.464 0.0144 *
## instructionregulate:dot_within 1.568 0.1174
## wave2:dot_within -1.257 0.2087
## dot_between:instructionregulate:wave2 0.933 0.3519
## instructionregulate:wave2:dot_within 1.801 0.0717 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Correlation of Fixed Effects:
## (Intr) dt_btw instrc wave2 dt_wth dt_bt: dt_b:2 inst:2 inst:_
## dot_between -0.077
## instrctnrgl -0.474 0.030
## wave2 -0.254 0.027 0.095
## dot_within 0.185 0.021 -0.129 -0.095
## dt_btwn:nst 0.033 -0.447 -0.068 -0.008 -0.018
## dt_btwn:wv2 0.025 -0.369 -0.008 -0.161 -0.017 0.140
## instrctnr:2 0.057 -0.006 -0.405 -0.630 0.088 0.030 0.099
## instrctnr:_ -0.176 -0.012 0.002 0.041 -0.757 0.003 0.015 0.073
## wv2:dt_wthn -0.120 -0.015 0.101 0.179 -0.635 0.013 0.022 -0.199 0.467
## dt_btwn:n:2 -0.006 0.140 0.031 0.101 0.019 -0.493 -0.617 -0.140 -0.008
## instrct:2:_ 0.089 0.009 -0.006 -0.138 0.464 -0.002 -0.016 0.028 -0.647
## wv2:d_ dt_::2
## dot_between
## instrctnrgl
## wave2
## dot_within
## dt_btwn:nst
## dt_btwn:wv2
## instrctnr:2
## instrctnr:_
## wv2:dt_wthn
## dt_btwn:n:2 -0.025
## instrct:2:_ -0.733 0.004
## optimizer (bobyqa) convergence code: 1 (bobyqa -- maximum number of function evaluations exceeded)
## Model failed to converge with max|grad| = 0.0146957 (tol = 0.002, component 1)